CICA 1994 April/CICA Shareware for Windows CD-ROM (Walnut Creek CD-ROM)(April 1994).ISO/win3/programr/vbasic/datamgr.exe/MAINFORM.FRM

Visual Basic Form | 1993-04-25 | 7.5 KB | 274 lines

VERSION 2.00
Begin MDIForm MainForm
   Caption         =   "Data Manager"
   ClientHeight    =   5850
   ClientLeft      =   1245
   ClientTop       =   1800
   ClientWidth     =   8115
   Height          =   6540
   HelpContextID   =   100
   Icon            =   MAINFORM.FRX:0000
   Left            =   1185
   LinkTopic       =   "MDIForm1"
   Top             =   1170
   Width           =   8235
   Begin PictureBox Picture1
      Align           =   1  'Align Top
      Height          =   615
      Left            =   0
      ScaleHeight     =   585
      ScaleWidth      =   8085
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   8115
      Begin CommonDialog CMDialog1
         Left            =   120
         Top             =   60
      End
      Begin Label TableName
         Caption         =   "Label1"
         Height          =   375
         Left            =   840
         TabIndex        =   1
         Top             =   120
         Width           =   975
      End
   End
   Begin Menu mFile
      Caption         =   "&File"
      Begin Menu mNewDatabase
         Caption         =   "&New Database"
         Begin Menu mNewDB
            Caption         =   "&Access 1.0"
            Index           =   0
         End
         Begin Menu mNewDB
            Caption         =   "A&ccess 1.1"
            Index           =   1
         End
      End
      Begin Menu mOpenDatabase
         Caption         =   "&Open Database"
         Begin Menu mOpenAccess
            Caption         =   "&Access"
         End
         Begin Menu mOpenFox
            Caption         =   "&FoxPro 2.0"
            Index           =   0
         End
         Begin Menu mOpenFox
            Caption         =   "F&oxPro 2.5"
            Index           =   1
         End
         Begin Menu mOpenODBC
            Caption         =   "&ODBC"
            Visible         =   0   'False
         End
         Begin Menu mOpendBase
            Caption         =   "dBa&se III"
         End
         Begin Menu mOpendBaseIV
            Caption         =   "&dBase IV"
         End
         Begin Menu mOpenParadox
            Caption         =   "&Paradox 3.X"
         End
         Begin Menu mOpenBTrieve
            Caption         =   "&Btrieve"
         End
      End
      Begin Menu mCloseDatabase
         Caption         =   "&Close Database"
         Enabled         =   0   'False
      End
      Begin Menu mJunk5
         Caption         =   "-"
      End
      Begin Menu mRepairDatabase
         Caption         =   "&Repair Database..."
      End
      Begin Menu mCompactDatabase
         Caption         =   "Co&mpact Database..."
      End
      Begin Menu mJunk1
         Caption         =   "-"
      End
      Begin Menu mExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mWindow
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin Menu mTile
         Caption         =   "&Tile"
         Visible         =   0   'False
      End
      Begin Menu mCascade
         Caption         =   "&Cascade"
      End
      Begin Menu mArrange
         Caption         =   "&Arrange"
         Visible         =   0   'False
      End
   End
   Begin Menu mHelpMenu
      Caption         =   "&Help"
      Begin Menu mHelpItem
         Caption         =   "&Contents"
         Index           =   0
      End
   End
Option Explicit
Sub mArrange_Click ()
    Arrange 3
End Sub
Sub mCascade_Click ()
    Arrange 0
End Sub
Sub mCloseDatabase_Click ()
    Dim success As Integer
    success = CloseCurrentDatabase()
End Sub
Sub mCompactDatabase_Click ()
    Dim X As Integer
    Dim fromdb As String
    On Error Resume Next
    cmdialog1.DefaultExt = "mdb"
    cmdialog1.DialogTitle = "Database to Compact From"
    cmdialog1.CancelError = True
    cmdialog1.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
    cmdialog1.Flags = &H4& Or &H1000&
    cmdialog1.Action = 1
    fromdb = cmdialog1.Filename
    If Err <> 32755 Then
    Do
    cmdialog1.Filename = ""
    cmdialog1.DialogTitle = "Database to Compact To"
    cmdialog1.CancelError = True
    cmdialog1.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
    cmdialog1.Flags = &H4&
    cmdialog1.Action = 2
    If Err <> 32755 Then
        If fromdb = cmdialog1.Filename Then
        MsgBox "The FROM and the TO databases may not be the same database", 64, "Data Manager"
        Else
        CompactDatabase fromdb, cmdialog1.Filename
        If Err <> 0 Then
            MsgBox Error$, 64, "Data Manager"
        End If
        End If
    Else
        cmdialog1.Filename = "" 'Cancel ends the operation
    End If
    Loop While fromdb = cmdialog1.Filename
    End If
End Sub
Sub MDIForm_Load ()
    Me.WindowState = 2
    gDatabaseName = ""
    Me.Tag = "Main"
    SetDataAccessOption 1, "vb.ini"
End Sub
Sub MDIForm_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    Dim success As Integer
    Cancel = Not CloseCurrentDatabase()
End Sub
Sub mExit_Click ()
    Unload Me
    End
End Sub
Sub mFile_Click ()
    If gDatabaseName = "" Then
    mCloseDatabase.Enabled = False
    Else
    mCloseDatabase.Enabled = True
    End If
End Sub
Sub mHelpItem_Click (Index As Integer)
    Dim I As Integer
    If Index = 0 Then
    I = Shell("winhelp " + app.Path + "\datamgr.hlp", 1)
    End If
End Sub
Sub mNewDB_Click (Index As Integer)
'If Index is 0 then Access 1.0
'If Index is 1 then Access 1.1
    If CloseCurrentDatabase() Then
    OpenNewDatabase cmdialog1, Abs(Index - 1)
    End If
End Sub
Sub mOpenAccess_Click ()
    Dim X As Integer
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "Access"
    End If
End Sub
Sub mOpenBTrieve_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "Btrieve"
    End If
End Sub
Sub mOpenDbase_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "dBase III"
    End If
End Sub
Sub mOpendBaseIV_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "dBase IV"
    End If
End Sub
Sub mOpenFox_Click (Index As Integer)
    If Index = 0 Then
    If CloseCurrentDatabase() Then
        OpenADatabase cmdialog1, "FoxPro 2.0"
    End If
    Else
    If CloseCurrentDatabase() Then
        OpenADatabase cmdialog1, "FoxPro 2.5"
    End If
    End If
End Sub
Sub mOpenODBC_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "ODBC"
    End If
End Sub
Sub mOpenParadox_Click ()
    If CloseCurrentDatabase() Then
    OpenADatabase cmdialog1, "Paradox 3.X"
    End If
End Sub
Sub mRepairDatabase_Click ()

    On Error Resume Next
    cmdialog1.DefaultExt = "mdb"
    cmdialog1.DialogTitle = "Database to Repair"
    cmdialog1.CancelError = True
    cmdialog1.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*|"
    cmdialog1.Flags = &H4& Or &H1000&
    cmdialog1.Action = 1
    If Err <> 32755 Then
    RepairDatabase cmdialog1.Filename
    If Err <> 0 Then
        MsgBox Error$, 64, "Data Manager"
    End If
    End If
End Sub
Sub mTile_Click ()
    Arrange 1
End Sub
Sub mWindow_Click ()
    If gDatabaseName = "" Then
    mCascade.Enabled = False
    mtile.Enabled = False
    mArrange.Enabled = False
    Else
    mCascade.Enabled = True
    mtile.Enabled = True
    mArrange.Enabled = True
    End If
End Sub